COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	(DF MV (L  X)
C00005 ENDMK
C⊗;
(DF MV (L ;; X)
  (WHILE L (SETQ X (NEXTL L))
         (SETQ * (IF (NUMBP X) (NTH X *) (CAR *))))
  (P 1))

(DE SPRINT (N L)
  (PRINT (IF (OR (ATOM L) (ZEROP N)) L (SPRC L 0 N))))))))))

(DE SPRC (L N1 N2) (COND
  ((NULL L) NIL)
  ((GT N1 N2) '*)
  ((ATOM L) L)
  ((CONS (SPRC (NEXTL L) (ADD1 N1) N2) (SPRC L N1 N2)))))))))

(DE FIND (L A P) (COND
  ((ATOM L) NIL)
  ((AND A (EQUAL (CAR L) A)) L)
  ((AND P (FILTER (CAR L) P)) L)
  ((OR (FIND (NEXTL L) A P) (FIND L A P)))))))))))))

(DE FILTER (D P) (COND
  ((EQ P '?))
  ((NULL P) (NULL D))
  ((ATOM (CAR P))
   (IF (OR (EQ (CAR P) '?) (EQ (CAR P) (CAR D)))
       (FILTER (CDR D) (CDR P))))
  ((FILTER (NEXTL D) (NEXTL P)) (FILTER D P)))))))))))

(DF EF (F) (SETQ * (CADDR (CAR F))) (P 1))
(DE P (N) (SPRINT N *) '*))))))
(DF IL (E)
  (NCONC * E)
  (P 1))
(DF I (L)
  (NCONC L (CONS (CAR *) (CDR *)))
  (RPLACB * L)
  (P 1))))))

(DF FP (F)
  (SETQ * (FIND * NIL (CAR F)))
  (P 1))))))))

(DF FK (A)
  (SETQ * (FIND * (CAR A) NIL))
  (P 1)))))))

(DE D (N) (REPEAT N (RPLACB * (CDR *)))
  (P 1))))


(DF DL ( ;; X)
  (SETQ X *) (WHILE (CDDR X) (NEXTL X)) (RPLACD X) (P 1))

(DF ADVISE (L ;; NOM EXP RES1)
  (SETQ NOM (NEXTL L) EXP (CADDR NOM) RES1 (LIST 'PROGN))
  (PUT NOM EXP 'ADVISE)
  (WHILE (NEQ (CAR L) '*) (NCONC1 RES1 (NEXTL L)))
  (NEXTL L)
  (RPLACA (CDDR (CDDR NOM))
   	  (CONS LAMBDA (CONS (CADR EXP)
		             (CONS (LIST 'SETQ '-VAL- (NCONC RES1
							    (CDDR EXP)))
				   (NCONC1 L '-VAL-)))))
  (CONS NOM)))))))))


(DF UNADVISE (L)
  (RPLACA (CDDR (CDDAR L)) (GET (CAR L) 'ADVISE))
  L)